open Base
open Unique_id.Ids

type t =
  | Tree of Tree.tag * t list
  | Dynamic of t Behavior.t
  | Fold of Src.value * (Event.t -> Src.value -> Src.value) * (Src_id.t -> t)
  | Bind of Var_id.t * Src_id.t * t
and component = t

let rect w h =
  Tree(Tree.Rect(w, h), [])

let tree_b behav =
  Dynamic(Behavior.map behav ~f:(fun (w, h) -> rect w h))

let arm dir cs =
  Tree(Tree.Arm(dir), cs)

let fold ~init ~f make_comp =
  Fold(init, f, fun src -> make_comp (Behavior.of_src src))

let fold_var ~init ~f var comp =
  let init = Behavior.upcast var init in
  let f e x = Behavior.upcast1 var (f e) x in
  Fold(init, f, fun src -> Bind(Behavior.var_id var, src, comp))

(*****)

module type CONTEXT = sig
  type t
  type deleter

  val src_vals : t -> Src.values

  val create_source
    :  t
    -> init:Src.value
    -> Src_id.t

  val create_sink
    :  t
    -> env:Env.t
    -> tree:Tree.t
    -> render:(Src.values -> component)
    -> del:deleter
    -> Sink_id.t

  val connect
    :  t
    -> Sink_id.t
    -> Src_id.t
    -> unit

  val capture_deleter
    :  t
    -> f:(unit -> 'a)
    -> (deleter * 'a)
end

module type INST = sig
  type ctx
  type deleter
  val inst : ctx -> Env.t -> component -> Tree.t
end

module Make_inst(Ctx : CONTEXT)
  : INST with type ctx := Ctx.t
          and type deleter := Ctx.deleter =
struct
  let rec inst ctx env = function
    | Tree(tag, comps) ->
       let tree = Tree.create tag in
       let () = Tree.set_children tree (List.map comps ~f:(inst ctx env)) in
       let () = Env.bind_event_handlers env tree in
       tree

    | Dynamic(behav) ->
       let (deps, render) = behav.eval env.vars in
       let init_comp = render (Ctx.src_vals ctx) in
       let (del, tree) = Ctx.capture_deleter ctx
                           ~f:(fun () -> inst ctx env init_comp) in
       let sink_id = Ctx.create_sink ctx ~env ~tree ~render ~del in
       let () = Set.iter deps ~f:(Ctx.connect ctx sink_id) in
       tree

    | Fold(init, f, make_comp) ->
       let src = Ctx.create_source ctx ~init in
       let env = Env.with_event_handler env
                   ~f:(fun evt -> Src.single_effect src (f evt)) in
       inst ctx env (make_comp src)

    | Bind(var, src, comp) ->
       inst ctx (Env.with_var env var src) comp

end
